home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / mac / tclMacFCmd.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  40.0 KB  |  1,409 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclMacFCmd.c --
  3.  *
  4.  * Implements the Macintosh specific portions of the file manipulation
  5.  * subcommands of the "file" command.
  6.  *
  7.  * Copyright (c) 1996-1997 Sun Microsystems, Inc.
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  *
  12.  * SCCS: @(#) tclMacFCmd.c 1.22 97/05/20 15:44:26
  13.  */
  14.  
  15. #include "tclInt.h"
  16. #include "tclMac.h"
  17. #include "tclMacInt.h"
  18. #include "tclPort.h"
  19. #include <FSpCompat.h>
  20. #include <MoreFilesExtras.h>
  21. #include <Strings.h>
  22. #include <Errors.h>
  23. #include <FileCopy.h>
  24. #include <DirectoryCopy.h>
  25. #include <Script.h>
  26. #include <string.h>
  27. #include <Finder.h>
  28.  
  29. /*
  30.  * Callback for the file attributes code.
  31.  */
  32.  
  33. static int        GetFileFinderAttributes _ANSI_ARGS_((Tcl_Interp *interp,
  34.                 int objIndex, char *fileName,
  35.                 Tcl_Obj **attributePtrPtr));
  36. static int        GetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
  37.                 int objIndex, char *fileName,
  38.                 Tcl_Obj **readOnlyPtrPtr));
  39. static int        SetFileFinderAttributes _ANSI_ARGS_((Tcl_Interp *interp,
  40.                 int objIndex, char *fileName,
  41.                 Tcl_Obj *attributePtr));
  42. static int        SetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
  43.                 int objIndex, char *fileName,
  44.                 Tcl_Obj *readOnlyPtr));
  45.  
  46. /*
  47.  * These are indeces into the tclpFileAttrsStrings table below.
  48.  */
  49.  
  50. #define MAC_CREATOR_ATTRIBUTE    0
  51. #define MAC_HIDDEN_ATTRIBUTE    1
  52. #define MAC_READONLY_ATTRIBUTE    2
  53. #define MAC_TYPE_ATTRIBUTE    3
  54.  
  55. /*
  56.  * Global variables for the file attributes code.
  57.  */
  58.  
  59. char *tclpFileAttrStrings[] = {"-creator", "-hidden", "-readonly",
  60.     "-type", (char *) NULL};
  61. CONST TclFileAttrProcs tclpFileAttrProcs[] = {
  62.     {GetFileFinderAttributes, SetFileFinderAttributes},
  63.     {GetFileFinderAttributes, SetFileFinderAttributes},
  64.     {GetFileReadOnly, SetFileReadOnly},
  65.     {GetFileFinderAttributes, SetFileFinderAttributes}};
  66.  
  67.  
  68. /*
  69.  * Prototypes for procedure only used in this file
  70.  */
  71.  
  72. static pascal Boolean     CopyErrHandler _ANSI_ARGS_((OSErr error, 
  73.                 short failedOperation,
  74.                 short srcVRefNum, long srcDirID,
  75.                 StringPtr srcName, short dstVRefNum,
  76.                 long dstDirID,StringPtr dstName));
  77. OSErr            FSpGetFLockCompat _ANSI_ARGS_((const FSSpec *specPtr, 
  78.                 Boolean *lockedPtr));
  79. static OSErr        GenerateUniqueName _ANSI_ARGS_((short vRefNum, 
  80.                 long dirID1, long dirID2, Str31 uniqueName));
  81. static OSErr        GetFileSpecs _ANSI_ARGS_((char *path, FSSpec *pathSpecPtr,
  82.                 FSSpec *dirSpecPtr,    Boolean *pathExistsPtr,    
  83.                 Boolean *pathIsDirectoryPtr));
  84. static OSErr        MoveRename _ANSI_ARGS_((const FSSpec *srcSpecPtr, 
  85.                 const FSSpec *dstSpecPtr, StringPtr copyName));
  86. static int        Pstrequal _ANSI_ARGS_((ConstStr255Param stringA, 
  87.                 ConstStr255Param stringB));
  88.                  
  89. /*
  90.  *---------------------------------------------------------------------------
  91.  *
  92.  * TclpRenameFile --
  93.  *
  94.  *      Changes the name of an existing file or directory, from src to dst.
  95.  *    If src and dst refer to the same file or directory, does nothing
  96.  *    and returns success.  Otherwise if dst already exists, it will be
  97.  *    deleted and replaced by src subject to the following conditions:
  98.  *        If src is a directory, dst may be an empty directory.
  99.  *        If src is a file, dst may be a file.
  100.  *    In any other situation where dst already exists, the rename will
  101.  *    fail.  
  102.  *
  103.  * Results:
  104.  *    If the directory was successfully created, returns TCL_OK.
  105.  *    Otherwise the return value is TCL_ERROR and errno is set to
  106.  *    indicate the error.  Some possible values for errno are:
  107.  *
  108.  *    EACCES:     src or dst parent directory can't be read and/or written.
  109.  *    EEXIST:        dst is a non-empty directory.
  110.  *    EINVAL:        src is a root directory or dst is a subdirectory of src.
  111.  *    EISDIR:        dst is a directory, but src is not.
  112.  *    ENOENT:        src doesn't exist.  src or dst is "".
  113.  *    ENOTDIR:    src is a directory, but dst is not.  
  114.  *    EXDEV:        src and dst are on different filesystems.
  115.  *    
  116.  * Side effects:
  117.  *    The implementation of rename may allow cross-filesystem renames,
  118.  *    but the caller should be prepared to emulate it with copy and
  119.  *    delete if errno is EXDEV.
  120.  *
  121.  *---------------------------------------------------------------------------
  122.  */
  123.  
  124. int
  125. TclpRenameFile( 
  126.     char *src,            /* Pathname of file or dir to be renamed. */
  127.     char *dst)             /* New pathname for file or directory. */
  128. {
  129.     FSSpec srcFileSpec, dstFileSpec, dstDirSpec;
  130.     OSErr err; 
  131.     long srcID, dummy;
  132.     Boolean srcIsDirectory, dstIsDirectory, dstExists, dstLocked;
  133.  
  134.     err = FSpLocationFromPath(strlen(src), src, &srcFileSpec);
  135.     if (err == noErr) {
  136.     FSpGetDirectoryID(&srcFileSpec, &srcID, &srcIsDirectory);
  137.     }
  138.     if (err == noErr) {
  139.         err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists, 
  140.             &dstIsDirectory);
  141.     }
  142.     if (err == noErr) {
  143.     if (dstExists == 0) {
  144.             err = MoveRename(&srcFileSpec, &dstDirSpec, dstFileSpec.name);
  145.             goto end;
  146.         }
  147.         err = FSpGetFLockCompat(&dstFileSpec, &dstLocked);
  148.         if (dstLocked) {
  149.             FSpRstFLockCompat(&dstFileSpec);
  150.         }
  151.     }
  152.     if (err == noErr) {
  153.         if (srcIsDirectory) {
  154.         if (dstIsDirectory) {
  155.         /*
  156.          * The following call will remove an empty directory.  If it
  157.          * fails, it's because it wasn't empty.
  158.          */
  159.          
  160.                 if (TclpRemoveDirectory(dst, 0, NULL) != TCL_OK) {
  161.                     return TCL_ERROR;
  162.                 }
  163.                 
  164.                 /*
  165.          * Now that that empty directory is gone, we can try
  166.          * renaming src.  If that fails, we'll put this empty
  167.          * directory back, for completeness.
  168.          */
  169.  
  170.         err = MoveRename(&srcFileSpec, &dstDirSpec, dstFileSpec.name);
  171.                 if (err != noErr) {
  172.             FSpDirCreateCompat(&dstFileSpec, smSystemScript, &dummy);
  173.             if (dstLocked) {
  174.                 FSpSetFLockCompat(&dstFileSpec);
  175.             }
  176.         }
  177.         } else {
  178.             errno = ENOTDIR;
  179.             return TCL_ERROR;
  180.         }
  181.     } else {   
  182.         if (dstIsDirectory) {
  183.         errno = EISDIR;
  184.         return TCL_ERROR;
  185.         } else {                                
  186.         /*
  187.          * Overwrite existing file by:
  188.          * 
  189.          * 1. Rename existing file to temp name.
  190.          * 2. Rename old file to new name.
  191.          * 3. If success, delete temp file.  If failure,
  192.          *    put temp file back to old name.
  193.          */
  194.  
  195.             Str31 tmpName;
  196.             FSSpec tmpFileSpec;
  197.  
  198.             err = GenerateUniqueName(dstFileSpec.vRefNum, 
  199.                 dstFileSpec.parID, dstFileSpec.parID, tmpName);
  200.             if (err == noErr) {
  201.                 err = FSpRenameCompat(&dstFileSpec, tmpName);
  202.             }
  203.             if (err == noErr) {
  204.                 err = FSMakeFSSpecCompat(dstFileSpec.vRefNum,
  205.                         dstFileSpec.parID, tmpName, &tmpFileSpec);
  206.             }
  207.             if (err == noErr) {
  208.                 err = MoveRename(&srcFileSpec, &dstDirSpec, 
  209.                         dstFileSpec.name);
  210.             }
  211.             if (err == noErr) {
  212.             FSpDeleteCompat(&tmpFileSpec);
  213.         } else {
  214.             FSpDeleteCompat(&dstFileSpec);
  215.             FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
  216.                 if (dstLocked) {
  217.                     FSpSetFLockCompat(&dstFileSpec);
  218.                 }
  219.             }
  220.         }
  221.        }
  222.     }    
  223.  
  224.     end:    
  225.     if (err != noErr) {
  226.     errno = TclMacOSErrorToPosixError(err);
  227.     return TCL_ERROR;
  228.     }
  229.     return TCL_OK;
  230. }
  231.  
  232. /*
  233.  *---------------------------------------------------------------------------
  234.  *
  235.  * TclpCopyFile --
  236.  *
  237.  *      Copy a single file (not a directory).  If dst already exists and
  238.  *    is not a directory, it is removed.
  239.  *
  240.  * Results:
  241.  *    If the file was successfully copied, returns TCL_OK.  Otherwise
  242.  *    the return value is TCL_ERROR and errno is set to indicate the
  243.  *    error.  Some possible values for errno are:
  244.  *
  245.  *    EACCES:     src or dst parent directory can't be read and/or written.
  246.  *    EISDIR:        src or dst is a directory.
  247.  *    ENOENT:        src doesn't exist.  src or dst is "".
  248.  *
  249.  * Side effects:
  250.  *      This procedure will also copy symbolic links, block, and
  251.  *      character devices, and fifos.  For symbolic links, the links 
  252.  *      themselves will be copied and not what they point to.  For the
  253.  *    other special file types, the directory entry will be copied and
  254.  *    not the contents of the device that it refers to.
  255.  *
  256.  *---------------------------------------------------------------------------
  257.  */
  258.  
  259. int 
  260. TclpCopyFile(
  261.     char *src,            /* Pathname of file to be copied. */
  262.     char *dst)            /* Pathname of file to copy to. */
  263. {
  264.     OSErr err, dstErr;
  265.     Boolean dstExists, dstIsDirectory, dstLocked;
  266.     FSSpec srcFileSpec, dstFileSpec, dstDirSpec, tmpFileSpec;
  267.     Str31 tmpName;
  268.     
  269.     err = FSpLocationFromPath(strlen(src), src, &srcFileSpec);
  270.     if (err == noErr) {
  271.         err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists,
  272.             &dstIsDirectory);
  273.     }
  274.     if (dstExists) {
  275.         if (dstIsDirectory) {
  276.             errno = EISDIR;
  277.             return TCL_ERROR;
  278.         }
  279.         err = FSpGetFLockCompat(&dstFileSpec, &dstLocked);
  280.         if (dstLocked) {
  281.             FSpRstFLockCompat(&dstFileSpec);
  282.         }
  283.         
  284.         /*
  285.          * Backup dest file.
  286.          */
  287.          
  288.         dstErr = GenerateUniqueName(dstFileSpec.vRefNum, dstFileSpec.parID, 
  289.                 dstFileSpec.parID, tmpName);
  290.         if (dstErr == noErr) {
  291.             dstErr = FSpRenameCompat(&dstFileSpec, tmpName);
  292.         }   
  293.     }
  294.     if (err == noErr) {
  295.         err = FSpFileCopy(&srcFileSpec, &dstDirSpec, 
  296.             (StringPtr) dstFileSpec.name, NULL, 0, true);
  297.     }
  298.     if ((dstExists != false) && (dstErr == noErr)) {
  299.         FSMakeFSSpecCompat(dstFileSpec.vRefNum, dstFileSpec.parID,
  300.             tmpName, &tmpFileSpec);
  301.     if (err == noErr) {
  302.         /* 
  303.          * Delete backup file. 
  304.          */
  305.          
  306.         FSpDeleteCompat(&tmpFileSpec);
  307.     } else {
  308.     
  309.         /* 
  310.          * Restore backup file.
  311.          */
  312.          
  313.         FSpDeleteCompat(&dstFileSpec);
  314.         FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
  315.         if (dstLocked) {
  316.             FSpSetFLockCompat(&dstFileSpec);
  317.         }
  318.     }
  319.     }
  320.     
  321.     if (err != noErr) {
  322.     errno = TclMacOSErrorToPosixError(err);
  323.     return TCL_ERROR;
  324.     }
  325.     return TCL_OK;
  326. }
  327.  
  328. /*
  329.  *---------------------------------------------------------------------------
  330.  *
  331.  * TclpDeleteFile --
  332.  *
  333.  *      Removes a single file (not a directory).
  334.  *
  335.  * Results:
  336.  *    If the file was successfully deleted, returns TCL_OK.  Otherwise
  337.  *    the return value is TCL_ERROR and errno is set to indicate the
  338.  *    error.  Some possible values for errno are:
  339.  *
  340.  *    EACCES:     a parent directory can't be read and/or written.
  341.  *    EISDIR:        path is a directory.
  342.  *    ENOENT:        path doesn't exist or is "".
  343.  *
  344.  * Side effects:
  345.  *      The file is deleted, even if it is read-only.
  346.  *
  347.  *---------------------------------------------------------------------------
  348.  */
  349.  
  350. int
  351. TclpDeleteFile( 
  352.     char *path)            /* Pathname of file to be removed. */
  353. {
  354.     OSErr err;
  355.     FSSpec fileSpec;
  356.     Boolean isDirectory;
  357.     long dirID;
  358.     
  359.     err = FSpLocationFromPath(strlen(path), path, &fileSpec);
  360.     if (err == noErr) {
  361.     /*
  362.           * Since FSpDeleteCompat will delete an empty directory, make sure
  363.           * that this isn't a directory first.
  364.          */
  365.         
  366.         FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
  367.     if (isDirectory == true) {
  368.             errno = EISDIR;
  369.             return TCL_ERROR;
  370.         }
  371.     }
  372.     err = FSpDeleteCompat(&fileSpec);
  373.     if (err == fLckdErr) {
  374.         FSpRstFLockCompat(&fileSpec);
  375.         err = FSpDeleteCompat(&fileSpec);
  376.         if (err != noErr) {
  377.             FSpSetFLockCompat(&fileSpec);
  378.         }
  379.     }
  380.     if (err != noErr) {
  381.     errno = TclMacOSErrorToPosixError(err);
  382.     return TCL_ERROR;
  383.     }
  384.     return TCL_OK;
  385. }
  386.  
  387. /*
  388.  *---------------------------------------------------------------------------
  389.  *
  390.  * TclpCreateDirectory --
  391.  *
  392.  *      Creates the specified directory.  All parent directories of the
  393.  *    specified directory must already exist.  The directory is
  394.  *    automatically created with permissions so that user can access
  395.  *    the new directory and create new files or subdirectories in it.
  396.  *
  397.  * Results:
  398.  *    If the directory was successfully created, returns TCL_OK.
  399.  *    Otherwise the return value is TCL_ERROR and errno is set to
  400.  *    indicate the error.  Some possible values for errno are:
  401.  *
  402.  *    EACCES:     a parent directory can't be read and/or written.
  403.  *    EEXIST:        path already exists.
  404.  *    ENOENT:        a parent directory doesn't exist.
  405.  *
  406.  * Side effects:
  407.  *      A directory is created with the current umask, except that
  408.  *    permission for u+rwx will always be added.
  409.  *
  410.  *---------------------------------------------------------------------------
  411.  */
  412.  
  413. int
  414. TclpCreateDirectory(
  415.     char *path)            /* Pathname of directory to create. */
  416. {
  417.     OSErr err;
  418.     FSSpec dirSpec;
  419.     long outDirID;
  420.     
  421.     err = FSpLocationFromPath(strlen(path), path, &dirSpec);
  422.     if (err == noErr) {
  423.         err = dupFNErr;        /* EEXIST. */
  424.     } else if (err == fnfErr) {
  425.         err = FSpDirCreateCompat(&dirSpec, smSystemScript, &outDirID);
  426.     } 
  427.     
  428.     if (err != noErr) {
  429.     errno = TclMacOSErrorToPosixError(err);
  430.     return TCL_ERROR;
  431.     }
  432.     return TCL_OK;
  433. }
  434.  
  435. /*
  436.  *---------------------------------------------------------------------------
  437.  *
  438.  * TclpCopyDirectory --
  439.  *
  440.  *      Recursively copies a directory.  The target directory dst must
  441.  *    not already exist.  Note that this function does not merge two
  442.  *    directory hierarchies, even if the target directory is an an
  443.  *    empty directory.
  444.  *
  445.  * Results:
  446.  *    If the directory was successfully copied, returns TCL_OK.
  447.  *    Otherwise the return value is TCL_ERROR, errno is set to indicate
  448.  *    the error, and the pathname of the file that caused the error
  449.  *    is stored in errorPtr.  See TclpCreateDirectory and TclpCopyFile
  450.  *    for a description of possible values for errno.
  451.  *
  452.  * Side effects:
  453.  *      An exact copy of the directory hierarchy src will be created
  454.  *    with the name dst.  If an error occurs, the error will
  455.  *      be returned immediately, and remaining files will not be
  456.  *    processed.
  457.  *
  458.  *---------------------------------------------------------------------------
  459.  */
  460.  
  461. int
  462. TclpCopyDirectory(
  463.     char *src,            /* Pathname of directory to be copied.  */
  464.     char *dst,            /* Pathname of target directory. */
  465.     Tcl_DString *errorPtr)    /* If non-NULL, initialized DString for
  466.                  * error reporting. */
  467. {
  468.     OSErr err, saveErr;
  469.     long srcID, tmpDirID;
  470.     FSSpec srcFileSpec, dstFileSpec, dstDirSpec, tmpDirSpec, tmpFileSpec;
  471.     Boolean srcIsDirectory, srcLocked;
  472.     Boolean dstIsDirectory, dstExists;
  473.     Str31 tmpName;
  474.  
  475.     err = FSpLocationFromPath(strlen(src), src, &srcFileSpec);
  476.     if (err == noErr) {
  477.         err = FSpGetDirectoryID(&srcFileSpec, &srcID, &srcIsDirectory);
  478.     }
  479.     if (err == noErr) {
  480.         if (srcIsDirectory == false) {
  481.             err = afpObjectTypeErr;    /* ENOTDIR. */
  482.         }
  483.     }
  484.     if (err == noErr) {
  485.         err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists,
  486.             &dstIsDirectory);
  487.     }
  488.     if (dstExists) {
  489.         if (dstIsDirectory == false) {
  490.             err = afpObjectTypeErr;    /* ENOTDIR. */
  491.         } else {
  492.             err = dupFNErr;        /* EEXIST. */
  493.         }
  494.     }
  495.     if (err != noErr) {
  496.         goto done;
  497.     }        
  498.     if ((srcFileSpec.vRefNum == dstFileSpec.vRefNum) &&
  499.             (srcFileSpec.parID == dstFileSpec.parID) &&
  500.             (Pstrequal(srcFileSpec.name, dstFileSpec.name) != 0)) {
  501.         /*
  502.          * Copying on top of self.  No-op.
  503.          */
  504.                     
  505.         goto done;
  506.     }
  507.  
  508.     /*
  509.      * This algorthm will work making a copy of the source directory in
  510.      * the current directory with a new name, in a new directory with the
  511.      * same name, and in a new directory with a new name:
  512.      *
  513.      * 1. Make dstDir/tmpDir.
  514.      * 2. Copy srcDir/src to dstDir/tmpDir/src
  515.      * 3. Rename dstDir/tmpDir/src to dstDir/tmpDir/dst (if necessary).
  516.      * 4. CatMove dstDir/tmpDir/dst to dstDir/dst.
  517.      * 5. Remove dstDir/tmpDir.
  518.      */
  519.                 
  520.     err = FSpGetFLockCompat(&srcFileSpec, &srcLocked);
  521.     if (srcLocked) {
  522.         FSpRstFLockCompat(&srcFileSpec);
  523.     }
  524.     if (err == noErr) {
  525.         err = GenerateUniqueName(dstFileSpec.vRefNum, dstFileSpec.parID, 
  526.                 dstFileSpec.parID, tmpName);
  527.     }
  528.     if (err == noErr) {
  529.         FSMakeFSSpecCompat(dstFileSpec.vRefNum, dstFileSpec.parID,
  530.             tmpName, &tmpDirSpec);
  531.         err = FSpDirCreateCompat(&tmpDirSpec, smSystemScript, &tmpDirID);
  532.     }
  533.     if (err == noErr) {
  534.     err = FSpDirectoryCopy(&srcFileSpec, &tmpDirSpec, NULL, 0, true,
  535.             CopyErrHandler);
  536.     }
  537.     
  538.     /* 
  539.      * Even if the Copy failed, Rename/Move whatever did get copied to the
  540.      * appropriate final destination, if possible.  
  541.      */
  542.      
  543.     saveErr = err;
  544.     err = noErr;
  545.     if (Pstrequal(srcFileSpec.name, dstFileSpec.name) == 0) {
  546.         err = FSMakeFSSpecCompat(tmpDirSpec.vRefNum, tmpDirID, 
  547.             srcFileSpec.name, &tmpFileSpec);
  548.         if (err == noErr) {
  549.             err = FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
  550.         }
  551.     }
  552.     if (err == noErr) {
  553.         err = FSMakeFSSpecCompat(tmpDirSpec.vRefNum, tmpDirID,
  554.             dstFileSpec.name, &tmpFileSpec);
  555.     }
  556.     if (err == noErr) {
  557.         err = FSpCatMoveCompat(&tmpFileSpec, &dstDirSpec);
  558.     }
  559.     if (err == noErr) {
  560.         if (srcLocked) {
  561.             FSpSetFLockCompat(&dstFileSpec);
  562.         }
  563.     }
  564.     
  565.     FSpDeleteCompat(&tmpDirSpec);
  566.     
  567.     if (saveErr != noErr) {
  568.         err = saveErr;
  569.     }
  570.     
  571.     done:
  572.     if (err != noErr) {
  573.         errno = TclMacOSErrorToPosixError(err);
  574.         if (errorPtr != NULL) {
  575.             Tcl_DStringAppend(errorPtr, dst, -1);
  576.         }
  577.         return TCL_ERROR;
  578.     }
  579.     return TCL_OK;
  580. }
  581.  
  582. /*
  583.  *----------------------------------------------------------------------
  584.  *
  585.  * CopyErrHandler --
  586.  *
  587.  *      This procedure is called from the MoreFiles procedure 
  588.  *      FSpDirectoryCopy whenever an error occurs.
  589.  *
  590.  * Results:
  591.  *      False if the condition should not be considered an error, true
  592.  *      otherwise.
  593.  *
  594.  * Side effects:
  595.  *      Since FSpDirectoryCopy() is called only after removing any 
  596.  *      existing target directories, there shouldn't be any errors.
  597.  *      
  598.  *----------------------------------------------------------------------
  599.  */
  600.  
  601. static pascal Boolean 
  602. CopyErrHandler(
  603.     OSErr error,        /* Error that occured */
  604.     short failedOperation,    /* operation that caused the error */
  605.     short srcVRefNum,        /* volume ref number of source */
  606.     long srcDirID,        /* directory id of source */
  607.     StringPtr srcName,        /* name of source */
  608.     short dstVRefNum,        /* volume ref number of dst */
  609.     long dstDirID,        /* directory id of dst */
  610.     StringPtr dstName)        /* name of dst directory */
  611. {
  612.     return true;
  613. }
  614.  
  615. /*
  616.  *---------------------------------------------------------------------------
  617.  *
  618.  * TclpRemoveDirectory --
  619.  *
  620.  *    Removes directory (and its contents, if the recursive flag is set).
  621.  *
  622.  * Results:
  623.  *    If the directory was successfully removed, returns TCL_OK.
  624.  *    Otherwise the return value is TCL_ERROR, errno is set to indicate
  625.  *    the error, and the pathname of the file that caused the error
  626.  *    is stored in errorPtr.  Some possible values for errno are:
  627.  *
  628.  *    EACCES:     path directory can't be read and/or written.
  629.  *    EEXIST:        path is a non-empty directory.
  630.  *    EINVAL:        path is a root directory.
  631.  *    ENOENT:        path doesn't exist or is "".
  632.  *     ENOTDIR:    path is not a directory.
  633.  *
  634.  * Side effects:
  635.  *    Directory removed.  If an error occurs, the error will be returned
  636.  *    immediately, and remaining files will not be deleted.
  637.  *
  638.  *---------------------------------------------------------------------------
  639.  */
  640.  
  641. int
  642. TclpRemoveDirectory(
  643.     char *path,            /* Pathname of directory to be removed. */
  644.     int recursive,        /* If non-zero, removes directories that
  645.                  * are nonempty.  Otherwise, will only remove
  646.                  * empty directories. */
  647.     Tcl_DString *errorPtr)    /* If non-NULL, initialized DString for
  648.                  * error reporting. */
  649. {                 
  650.     OSErr err;
  651.     FSSpec fileSpec;
  652.     long dirID;
  653.     int locked;
  654.     Boolean isDirectory;
  655.     CInfoPBRec pb;
  656.     Str255 fileName;
  657.  
  658.     locked = 0;
  659.     err = FSpLocationFromPath(strlen(path), path, &fileSpec);
  660.     if (err != noErr) {
  661.         goto done;
  662.     }   
  663.  
  664.     /*
  665.      * Since FSpDeleteCompat will delete a file, make sure this isn't
  666.      * a file first.
  667.      */
  668.          
  669.     isDirectory = 1;
  670.     FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
  671.     if (isDirectory == 0) {
  672.         errno = ENOTDIR;
  673.         return TCL_ERROR;
  674.     }
  675.     
  676.     err = FSpDeleteCompat(&fileSpec);
  677.     if (err == fLckdErr) {
  678.         locked = 1;
  679.         FSpRstFLockCompat(&fileSpec);
  680.         err = FSpDeleteCompat(&fileSpec);
  681.     }
  682.     if (err == noErr) {
  683.     return TCL_OK;
  684.     }
  685.     if (err != fBsyErr) {
  686.         goto done;
  687.     }
  688.      
  689.     if (recursive == 0) {
  690.     /*
  691.      * fBsyErr means one of three things: file busy, directory not empty, 
  692.      * or working directory control block open.  Determine if directory
  693.      * is empty. If directory is not empty, return EEXIST.
  694.      */
  695.  
  696.     pb.hFileInfo.ioVRefNum = fileSpec.vRefNum;
  697.     pb.hFileInfo.ioDirID = dirID;
  698.     pb.hFileInfo.ioNamePtr = (StringPtr) fileName;
  699.     pb.hFileInfo.ioFDirIndex = 1;
  700.     if (PBGetCatInfoSync(&pb) == noErr) {
  701.         err = dupFNErr;    /* EEXIST */
  702.         goto done;
  703.     }
  704.     }
  705.     
  706.     /*
  707.      * DeleteDirectory removes a directory and all its contents, including
  708.      * any locked files.  There is no interface to get the name of the 
  709.      * file that caused the error, if an error occurs deleting this tree,
  710.      * unless we rewrite DeleteDirectory ourselves.
  711.      */
  712.      
  713.     err = DeleteDirectory(fileSpec.vRefNum, dirID, NULL);
  714.  
  715.     done:
  716.     if (err != noErr) {
  717.     if (errorPtr != NULL) {
  718.         Tcl_DStringAppend(errorPtr, path, -1);
  719.     }
  720.         if (locked) {
  721.             FSpSetFLockCompat(&fileSpec);
  722.         }
  723.         errno = TclMacOSErrorToPosixError(err);
  724.         return TCL_ERROR;
  725.     }
  726.     return TCL_OK;
  727. }
  728.  
  729. /*
  730.  *--------------------------------------------------------------------------
  731.  *
  732.  * MoveRename --
  733.  *
  734.  *    Helper function for TclpRenameFile.  Renames a file or directory
  735.  *    into the same directory or another directory.  The target name
  736.  *     must not already exist in the destination directory.
  737.  *
  738.  *    Don't use FSpMoveRenameCompat because it doesn't work with
  739.  *    directories or with locked files. 
  740.  *
  741.  * Results:
  742.  *    Returns a mac error indicating the cause of the failure.
  743.  *
  744.  * Side effects:
  745.  *    Creates a temp file in the target directory to handle a rename
  746.  *    between directories.
  747.  *
  748.  *--------------------------------------------------------------------------
  749.  */
  750.   
  751. static OSErr        
  752. MoveRename(
  753.     const FSSpec *srcFileSpecPtr,   /* Source object. */
  754.     const FSSpec *dstDirSpecPtr,    /* Destination directory. */
  755.     StringPtr copyName)            /* New name for object in destination 
  756.                          * directory. */
  757. {
  758.     OSErr err;
  759.     long srcID, dstID;
  760.     Boolean srcIsDir, dstIsDir;
  761.     Str31 tmpName;
  762.     FSSpec dstFileSpec, srcDirSpec, tmpSrcFileSpec, tmpDstFileSpec;
  763.     Boolean locked;
  764.     
  765.     if (srcFileSpecPtr->parID == 1) {
  766.         /*
  767.          * Trying to rename a volume.
  768.          */
  769.           
  770.         return badMovErr;
  771.     }
  772.     if (srcFileSpecPtr->vRefNum != dstDirSpecPtr->vRefNum) {
  773.     /*
  774.      * Renaming across volumes.
  775.      */
  776.      
  777.         return diffVolErr;
  778.     }
  779.     err = FSpGetFLockCompat(srcFileSpecPtr, &locked);
  780.     if (locked) {
  781.         FSpRstFLockCompat(srcFileSpecPtr);
  782.     }
  783.     if (err == noErr) {
  784.     err = FSpGetDirectoryID(dstDirSpecPtr, &dstID, &dstIsDir);
  785.     }
  786.     if (err == noErr) {
  787.         if (srcFileSpecPtr->parID == dstID) {
  788.             /*
  789.              * Renaming object within directory. 
  790.              */
  791.             
  792.             err = FSpRenameCompat(srcFileSpecPtr, copyName);
  793.             goto done; 
  794.         }
  795.         if (Pstrequal(srcFileSpecPtr->name, copyName)) {
  796.         /*
  797.          * Moving object to another directory (under same name). 
  798.          */
  799.      
  800.         err = FSpCatMoveCompat(srcFileSpecPtr, dstDirSpecPtr);
  801.         goto done; 
  802.         } 
  803.         err = FSpGetDirectoryID(srcFileSpecPtr, &srcID, &srcIsDir);
  804.     } 
  805.     if (err == noErr) {
  806.         /*
  807.          * Fullblown: rename source object to temp name, move temp to
  808.          * dest directory, and rename temp to target.
  809.          */
  810.           
  811.         err = GenerateUniqueName(srcFileSpecPtr->vRefNum, 
  812.                srcFileSpecPtr->parID, dstID, tmpName);
  813.         FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
  814.              tmpName, &tmpSrcFileSpec);
  815.         FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum, dstID, tmpName,
  816.              &tmpDstFileSpec);
  817.     }
  818.     if (err == noErr) {
  819.         err = FSpRenameCompat(srcFileSpecPtr, tmpName);
  820.     }
  821.     if (err == noErr) {
  822.         err = FSpCatMoveCompat(&tmpSrcFileSpec, dstDirSpecPtr);
  823.         if (err == noErr) {
  824.             err = FSpRenameCompat(&tmpDstFileSpec, copyName);
  825.             if (err == noErr) {
  826.                 goto done;
  827.             }
  828.             FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
  829.                      NULL, &srcDirSpec);
  830.             FSpCatMoveCompat(&tmpDstFileSpec, &srcDirSpec);
  831.         }                 
  832.         FSpRenameCompat(&tmpSrcFileSpec, srcFileSpecPtr->name);
  833.     }
  834.     
  835.     done:
  836.     if (locked != false) {
  837.         if (err == noErr) {
  838.         FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum, 
  839.                 dstID, copyName, &dstFileSpec);
  840.             FSpSetFLockCompat(&dstFileSpec);
  841.         } else {
  842.             FSpSetFLockCompat(srcFileSpecPtr);
  843.         }
  844.     }
  845.     return err;
  846. }     
  847.                 
  848. /*
  849.  *---------------------------------------------------------------------------
  850.  *
  851.  * GetFileSpecs --
  852.  *
  853.  *     Generate a filename that is not in either of the two specified
  854.  *    directories (on the same volume). 
  855.  *
  856.  * Results:
  857.  *    Standard macintosh error.  On success, uniqueName is filled with 
  858.  *    the name of the temporary file.
  859.  *
  860.  * Side effects:
  861.  *    None.
  862.  *
  863.  *---------------------------------------------------------------------------
  864.  */ 
  865.  
  866. static OSErr
  867. GenerateUniqueName(
  868.     short vRefNum,        /* Volume on which the following directories
  869.                      * are located. */        
  870.     long dirID1,        /* ID of first directory. */
  871.     long dirID2,        /* ID of second directory.  May be the same
  872.                      * as the first. */
  873.     Str31 uniqueName)        /* Filled with filename for a file that is
  874.                      * not located in either of the above two
  875.                      * directories. */
  876. {
  877.     OSErr err;
  878.     long i;
  879.     CInfoPBRec pb;
  880.     static unsigned char hexStr[16] = "0123456789ABCDEF";
  881.     static long startSeed = 248923489;
  882.     
  883.     pb.hFileInfo.ioVRefNum = vRefNum;
  884.     pb.hFileInfo.ioFDirIndex = 0;
  885.     pb.hFileInfo.ioNamePtr = uniqueName;
  886.  
  887.     while (1) {
  888.         startSeed++;        
  889.     pb.hFileInfo.ioNamePtr[0] = 8;
  890.     for (i = 1; i <= 8; i++) {
  891.         pb.hFileInfo.ioNamePtr[i] = hexStr[((startSeed >> ((8-i)*4)) & 0xf)];
  892.     }
  893.     pb.hFileInfo.ioDirID = dirID1;
  894.     err = PBGetCatInfoSync(&pb);
  895.     if (err == fnfErr) {
  896.         if (dirID1 != dirID2) {
  897.         pb.hFileInfo.ioDirID = dirID2;
  898.         err = PBGetCatInfoSync(&pb);
  899.         }
  900.         if (err == fnfErr) {
  901.             return noErr;
  902.         }
  903.     }
  904.     if (err == noErr) {
  905.         continue;
  906.     } 
  907.     return err;
  908.     }
  909. } 
  910.  
  911. /*
  912.  *---------------------------------------------------------------------------
  913.  *
  914.  * GetFileSpecs --
  915.  *
  916.  *    Gets FSSpecs for the specified path and its parent directory.
  917.  *
  918.  * Results:
  919.  *    The return value is noErr if there was no error getting FSSpecs,
  920.  *    otherwise it is an error describing the problem.  Fills buffers 
  921.  *    with information, as above.  
  922.  *
  923.  * Side effects:
  924.  *    None.
  925.  *
  926.  *---------------------------------------------------------------------------
  927.  */
  928.  
  929. static OSErr
  930. GetFileSpecs(
  931.     char *path,            /* The path to query. */
  932.     FSSpec *pathSpecPtr,    /* Filled with information about path. */
  933.     FSSpec *dirSpecPtr,        /* Filled with information about path's
  934.                      * parent directory. */
  935.     Boolean *pathExistsPtr,    /* Set to true if path actually exists, 
  936.                      * false if it doesn't or there was an 
  937.                      * error reading the specified path. */
  938.     Boolean *pathIsDirectoryPtr)/* Set to true if path is itself a directory,
  939.                      * otherwise false. */
  940. {
  941.     char *dirName;
  942.     OSErr err;
  943.     int argc;
  944.     char **argv;
  945.     long d;
  946.     Tcl_DString buffer;
  947.         
  948.     *pathExistsPtr = false;
  949.     *pathIsDirectoryPtr = false;
  950.     
  951.     Tcl_DStringInit(&buffer);
  952.     Tcl_SplitPath(path, &argc, &argv);
  953.     if (argc == 1) {
  954.         dirName = ":";
  955.     } else {
  956.         dirName = Tcl_JoinPath(argc - 1, argv, &buffer);
  957.     }
  958.     err = FSpLocationFromPath(strlen(dirName), dirName, dirSpecPtr);
  959.     Tcl_DStringFree(&buffer);
  960.     ckfree((char *) argv);
  961.  
  962.     if (err == noErr) {
  963.         err = FSpLocationFromPath(strlen(path), path, pathSpecPtr);
  964.         if (err == noErr) {
  965.             *pathExistsPtr = true;
  966.             err = FSpGetDirectoryID(pathSpecPtr, &d, pathIsDirectoryPtr);
  967.         } else if (err == fnfErr) {
  968.             err = noErr;
  969.         }
  970.     }
  971.     return err;
  972. }
  973.  
  974. /*
  975.  *-------------------------------------------------------------------------
  976.  *
  977.  * FSpGetFLockCompat --
  978.  *
  979.  *    Determines if there exists a software lock on the specified
  980.  *    file.  The software lock could prevent the file from being 
  981.  *    renamed or moved.
  982.  *
  983.  * Results:
  984.  *    Standard macintosh error code.  
  985.  *
  986.  * Side effects:
  987.  *    None.
  988.  *
  989.  *
  990.  *-------------------------------------------------------------------------
  991.  */
  992.  
  993. OSErr
  994. FSpGetFLockCompat(
  995.     const FSSpec *specPtr,    /* File to query. */
  996.     Boolean *lockedPtr)        /* Set to true if file is locked, false
  997.                      * if it isn't or there was an error reading
  998.                      * specified file. */
  999. {
  1000.     CInfoPBRec pb;
  1001.     OSErr err;
  1002.     
  1003.     pb.hFileInfo.ioVRefNum = specPtr->vRefNum;
  1004.     pb.hFileInfo.ioDirID = specPtr->parID;
  1005.     pb.hFileInfo.ioNamePtr = (StringPtr) specPtr->name;
  1006.     pb.hFileInfo.ioFDirIndex = 0;
  1007.     
  1008.     err = PBGetCatInfoSync(&pb);
  1009.     if ((err == noErr) && (pb.hFileInfo.ioFlAttrib & 0x01)) {
  1010.         *lockedPtr = true;
  1011.     } else {
  1012.         *lockedPtr = false;
  1013.     }
  1014.     return err;
  1015. }
  1016.     
  1017. /*
  1018.  *----------------------------------------------------------------------
  1019.  *
  1020.  * Pstrequal --
  1021.  *
  1022.  *      Pascal string compare. 
  1023.  *
  1024.  * Results:
  1025.  *      Returns 1 if strings equal, 0 otherwise.
  1026.  *
  1027.  * Side effects:
  1028.  *      None.
  1029.  *      
  1030.  *----------------------------------------------------------------------
  1031.  */
  1032.  
  1033. static int 
  1034. Pstrequal (
  1035.     ConstStr255Param stringA,    /* Pascal string A */
  1036.     ConstStr255Param stringB)   /* Pascal string B */
  1037. {
  1038.     int i, len;
  1039.     
  1040.     len = *stringA;
  1041.     for (i = 0; i <= len; i++) {
  1042.         if (*stringA++ != *stringB++) {
  1043.             return 0;
  1044.         }
  1045.     }
  1046.     return 1;
  1047. }
  1048.     
  1049. /*
  1050.  *----------------------------------------------------------------------
  1051.  *
  1052.  * GetFileFinderAttributes --
  1053.  *
  1054.  *    Returns a Tcl_Obj containing the value of a file attribute
  1055.  *    which is part of the FInfo record. Which attribute is controlled
  1056.  *    by objIndex.
  1057.  *
  1058.  * Results:
  1059.  *      Returns a standard TCL error. If the return value is TCL_OK,
  1060.  *    the new creator or file type object is put into attributePtrPtr.
  1061.  *    The object will have ref count 0. If there is an error,
  1062.  *    attributePtrPtr is not touched.
  1063.  *
  1064.  * Side effects:
  1065.  *      A new object is allocated if the file is valid.
  1066.  *      
  1067.  *----------------------------------------------------------------------
  1068.  */
  1069.  
  1070. static int
  1071. GetFileFinderAttributes(
  1072.     Tcl_Interp *interp,        /* The interp to report errors with. */
  1073.     int objIndex,        /* The index of the attribute option. */
  1074.     char *fileName,        /* The name of the file. */
  1075.     Tcl_Obj **attributePtrPtr)    /* A pointer to return the object with. */
  1076. {
  1077.     OSErr err;
  1078.     FSSpec fileSpec;
  1079.     FInfo finfo;
  1080.     
  1081.     err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
  1082.     
  1083.     if (err == noErr) {
  1084.         err = FSpGetFInfo(&fileSpec, &finfo);
  1085.     }
  1086.     
  1087.     if (err == noErr) {
  1088.         switch (objIndex) {
  1089.             case MAC_CREATOR_ATTRIBUTE:
  1090.                 *attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdCreator);
  1091.                 break;
  1092.             case MAC_HIDDEN_ATTRIBUTE:
  1093.                 *attributePtrPtr = Tcl_NewBooleanObj(finfo.fdFlags
  1094.                     & kIsInvisible);
  1095.                 break;
  1096.             case MAC_TYPE_ATTRIBUTE:
  1097.                 *attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdType);
  1098.                 break;
  1099.         }
  1100.     } else if (err == fnfErr) {
  1101.         long dirID;
  1102.         Boolean isDirectory = 0;
  1103.         
  1104.         err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
  1105.         if ((err == noErr) && isDirectory) {
  1106.             if (objIndex == MAC_HIDDEN_ATTRIBUTE) {
  1107.                 *attributePtrPtr = Tcl_NewBooleanObj(0);
  1108.             } else {
  1109.                 *attributePtrPtr = Tcl_NewOSTypeObj('Fldr');
  1110.             }
  1111.         }
  1112.     }
  1113.     
  1114.     if (err != noErr) {
  1115.         errno = TclMacOSErrorToPosixError(err);
  1116.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
  1117.             "couldn't get attributes for file \"", fileName, "\": ",
  1118.             Tcl_PosixError(interp), (char *) NULL);
  1119.         return TCL_ERROR;
  1120.     }
  1121.     return TCL_OK;
  1122. }
  1123.  
  1124. /*
  1125.  *----------------------------------------------------------------------
  1126.  *
  1127.  * GetFileReadOnly --
  1128.  *
  1129.  *    Returns a Tcl_Obj containing a Boolean value indicating whether
  1130.  *    or not the file is read-only. The object will have ref count 0.
  1131.  *    This procedure just checks the Finder attributes; it does not
  1132.  *    check AppleShare sharing attributes.
  1133.  *
  1134.  * Results:
  1135.  *      Returns a standard TCL error. If the return value is TCL_OK,
  1136.  *    the new creator type object is put into readOnlyPtrPtr.
  1137.  *    If there is an error, readOnlyPtrPtr is not touched.
  1138.  *
  1139.  * Side effects:
  1140.  *      A new object is allocated if the file is valid.
  1141.  *      
  1142.  *----------------------------------------------------------------------
  1143.  */
  1144.  
  1145. static int
  1146. GetFileReadOnly(
  1147.     Tcl_Interp *interp,        /* The interp to report errors with. */
  1148.     int objIndex,        /* The index of the attribute. */
  1149.     char *fileName,        /* The name of the file. */
  1150.     Tcl_Obj **readOnlyPtrPtr)    /* A pointer to return the object with. */
  1151. {
  1152.     OSErr err;
  1153.     FSSpec fileSpec;
  1154.     CInfoPBRec paramBlock;
  1155.     
  1156.     err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
  1157.     
  1158.     if (err == noErr) {
  1159.         if (err == noErr) {
  1160.             paramBlock.hFileInfo.ioCompletion = NULL;
  1161.             paramBlock.hFileInfo.ioNamePtr = fileSpec.name;
  1162.             paramBlock.hFileInfo.ioVRefNum = fileSpec.vRefNum;
  1163.             paramBlock.hFileInfo.ioFDirIndex = 0;
  1164.             paramBlock.hFileInfo.ioDirID = fileSpec.parID;
  1165.             err = PBGetCatInfo(¶mBlock, 0);
  1166.             if (err == noErr) {
  1167.             
  1168.                 /*
  1169.                  * For some unknown reason, the Mac does not give
  1170.                  * symbols for the bits in the ioFlAttrib field.
  1171.                  * 1 -> locked.
  1172.                  */
  1173.             
  1174.                 *readOnlyPtrPtr = Tcl_NewBooleanObj(
  1175.                     paramBlock.hFileInfo.ioFlAttrib & 1);
  1176.             }
  1177.         }
  1178.     }
  1179.     if (err != noErr) {
  1180.         errno = TclMacOSErrorToPosixError(err);
  1181.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
  1182.             "couldn't get attributes for file \"", fileName, "\": ",
  1183.             Tcl_PosixError(interp), (char *) NULL);
  1184.         return TCL_ERROR;
  1185.     }
  1186.     return TCL_OK;
  1187. }
  1188.  
  1189. /*
  1190.  *----------------------------------------------------------------------
  1191.  *
  1192.  * SetFileFinderAttributes --
  1193.  *
  1194.  *    Sets the file to the creator or file type given by attributePtr.
  1195.  *    objIndex determines whether the creator or file type is set.
  1196.  *
  1197.  * Results:
  1198.  *    Returns a standard TCL error.
  1199.  *
  1200.  * Side effects:
  1201.  *      The file's attribute is set.
  1202.  *      
  1203.  *----------------------------------------------------------------------
  1204.  */
  1205.  
  1206. static int
  1207. SetFileFinderAttributes(
  1208.     Tcl_Interp *interp,        /* The interp to report errors with. */
  1209.     int objIndex,        /* The index of the attribute. */
  1210.     char *fileName,        /* The name of the file. */
  1211.     Tcl_Obj *attributePtr)    /* The command line object. */
  1212. {
  1213.     OSErr err;
  1214.     FSSpec fileSpec;
  1215.     FInfo finfo;
  1216.     
  1217.     err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
  1218.     
  1219.     if (err == noErr) {
  1220.         err = FSpGetFInfo(&fileSpec, &finfo);
  1221.     }
  1222.     
  1223.     if (err == noErr) {
  1224.         switch (objIndex) {
  1225.             case MAC_CREATOR_ATTRIBUTE:
  1226.                 if (Tcl_GetOSTypeFromObj(interp, attributePtr,
  1227.                     &finfo.fdCreator) != TCL_OK) {
  1228.                     return TCL_ERROR;
  1229.                 }
  1230.                 break;
  1231.             case MAC_HIDDEN_ATTRIBUTE: {
  1232.                 int hidden;
  1233.                 
  1234.                 if (Tcl_GetBooleanFromObj(interp, attributePtr, &hidden)
  1235.                     != TCL_OK) {
  1236.                     return TCL_ERROR;
  1237.                 }
  1238.                 if (hidden) {
  1239.                     finfo.fdFlags |= kIsInvisible;
  1240.                 } else {
  1241.                     finfo.fdFlags &= ~kIsInvisible;
  1242.                 }
  1243.                 break;
  1244.             }
  1245.             case MAC_TYPE_ATTRIBUTE:
  1246.                 if (Tcl_GetOSTypeFromObj(interp, attributePtr,
  1247.                     &finfo.fdType) != TCL_OK) {
  1248.                     return TCL_ERROR;
  1249.                 }
  1250.                 break;
  1251.         }
  1252.         err = FSpSetFInfo(&fileSpec, &finfo);
  1253.     } else if (err == fnfErr) {
  1254.         long dirID;
  1255.         Boolean isDirectory = 0;
  1256.         
  1257.         err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
  1258.         if ((err == noErr) && isDirectory) {
  1259.             Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
  1260.             Tcl_AppendStringsToObj(resultPtr, "cannot set ",
  1261.                     tclpFileAttrStrings[objIndex], ": \"",
  1262.                     fileName, "\" is a directory", (char *) NULL);
  1263.             return TCL_ERROR;
  1264.         }
  1265.     }
  1266.     
  1267.     if (err != noErr) {
  1268.         errno = TclMacOSErrorToPosixError(err);
  1269.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
  1270.             "couldn't set attributes for file \"", fileName, "\": ",
  1271.             Tcl_PosixError(interp), (char *) NULL);
  1272.         return TCL_ERROR;
  1273.     }
  1274.     return TCL_OK;
  1275. }
  1276.  
  1277. /*
  1278.  *----------------------------------------------------------------------
  1279.  *
  1280.  * SetFileReadOnly --
  1281.  *
  1282.  *    Sets the file to be read-only according to the Boolean value
  1283.  *    given by hiddenPtr.
  1284.  *
  1285.  * Results:
  1286.  *    Returns a standard TCL error.
  1287.  *
  1288.  * Side effects:
  1289.  *      The file's attribute is set.
  1290.  *      
  1291.  *----------------------------------------------------------------------
  1292.  */
  1293.  
  1294. static int
  1295. SetFileReadOnly(
  1296.     Tcl_Interp *interp,        /* The interp to report errors with. */
  1297.     int objIndex,        /* The index of the attribute. */
  1298.     char *fileName,        /* The name of the file. */
  1299.     Tcl_Obj *readOnlyPtr)    /* The command line object. */
  1300. {
  1301.     OSErr err;
  1302.     FSSpec fileSpec;
  1303.     HParamBlockRec paramBlock;
  1304.     int hidden;
  1305.     
  1306.     err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
  1307.     
  1308.     if (err == noErr) {
  1309.         if (Tcl_GetBooleanFromObj(interp, readOnlyPtr, &hidden) != TCL_OK) {
  1310.             return TCL_ERROR;
  1311.         }
  1312.     
  1313.         paramBlock.fileParam.ioCompletion = NULL;
  1314.         paramBlock.fileParam.ioNamePtr = fileSpec.name;
  1315.         paramBlock.fileParam.ioVRefNum = fileSpec.vRefNum;
  1316.         paramBlock.fileParam.ioDirID = fileSpec.parID;
  1317.         if (hidden) {
  1318.             err = PBHSetFLock(¶mBlock, 0);
  1319.         } else {
  1320.             err = PBHRstFLock(¶mBlock, 0);
  1321.         }
  1322.     }
  1323.     
  1324.     if (err == fnfErr) {
  1325.         long dirID;
  1326.         Boolean isDirectory = 0;
  1327.         err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
  1328.         if ((err == noErr) && isDirectory) {
  1329.             Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1330.                     "cannot set a directory to read-only when File Sharing is turned off",
  1331.                     (char *) NULL);
  1332.             return TCL_ERROR;
  1333.         } else {
  1334.             err = fnfErr;
  1335.         }
  1336.     }
  1337.     
  1338.     if (err != noErr) {
  1339.         errno = TclMacOSErrorToPosixError(err);
  1340.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
  1341.             "couldn't set attributes for file \"", fileName, "\": ",
  1342.             Tcl_PosixError(interp), (char *) NULL);
  1343.         return TCL_ERROR;
  1344.     }
  1345.     return TCL_OK;
  1346. }
  1347.  
  1348. /*
  1349.  *---------------------------------------------------------------------------
  1350.  *
  1351.  * TclpListVolumes --
  1352.  *
  1353.  *    Lists the currently mounted volumes
  1354.  *
  1355.  * Results:
  1356.  *    A standard Tcl result.  Will always be TCL_OK, since there is no way
  1357.  *    that this command can fail.  Also, the interpreter's result is set to 
  1358.  *    the list of volumes.
  1359.  *
  1360.  * Side effects:
  1361.  *    None
  1362.  *
  1363.  *---------------------------------------------------------------------------
  1364.  */
  1365.  
  1366. int
  1367. TclpListVolumes( 
  1368.         Tcl_Interp *interp)    /* Interpreter to which to pass the volume list */
  1369. {
  1370.     HParamBlockRec pb;
  1371.     Str255 name;
  1372.     OSErr theError = noErr;
  1373.     Tcl_Obj *resultPtr, *elemPtr;
  1374.     short volIndex = 1;
  1375.  
  1376.     resultPtr = Tcl_NewObj();
  1377.         
  1378.     /*
  1379.      * We use two facts:
  1380.      * 1) The Mac volumes are enumerated by the ioVolIndex parameter of
  1381.      * the HParamBlockRec.  They run through the integers contiguously, 
  1382.      * starting at 1.  
  1383.      * 2) PBHGetVInfoSync returns an error when you ask for a volume index
  1384.      * that does not exist.
  1385.      * 
  1386.      */
  1387.         
  1388.     while ( 1 ) {
  1389.         pb.volumeParam.ioNamePtr = (StringPtr) & name;
  1390.         pb.volumeParam.ioVolIndex = volIndex;
  1391.                 
  1392.         theError = PBHGetVInfoSync(&pb);
  1393.  
  1394.         if ( theError != noErr ) {
  1395.             break;
  1396.         }
  1397.                 
  1398.         elemPtr = Tcl_NewStringObj((char *) name + 1, (int) name[0]);
  1399.         Tcl_AppendToObj(elemPtr, ":", 1);
  1400.         Tcl_ListObjAppendElement(interp, resultPtr, elemPtr);
  1401.                 
  1402.         volIndex++;             
  1403.     }
  1404.         
  1405.     Tcl_SetObjResult(interp, resultPtr);
  1406.     return TCL_OK;      
  1407. }
  1408.  
  1409.